home *** CD-ROM | disk | FTP | other *** search
Modula Implementation | 1993-08-16 | 22.7 KB | 657 lines |
- (*---------------------------------------------------------------------------
- :Program. IFFLoad.mod
- :Author. Fridtjof Siebert
- :Address. Nobileweg 67, D-7-Stgt-40
- :Phone. 0711/822509
- :Shortcut. [fbs]
- :Version. 1.1
- :Date. 20-May-88
- :Copyright. Shareware or PD, anyway you like. (I like Shareware better)
- :Language. Modula-II
- :Translator. M2Amiga
- :Imports. LoadBody.asm [fbs]
- :UpDate. 07-Jun-88: Maschinensprachteil [fbs]
- :Contents. Schnelle Ladeprozedur für IFF (ILBM)-Bilder.
- :Remark. Let's wave! The Cure. The Mission. Sisters of Mercy !!!
- ---------------------------------------------------------------------------*)
- IMPLEMENTATION MODULE IFFLoad;
-
- FROM SYSTEM IMPORT ADR, ADDRESS, SHIFT, BITSET, LONGSET, CAST, INLINE,
- REG;
-
- FROM Exec IMPORT AllocMem, FreeMem, MemReqs, MemReqSet, UByte,
- Interrupt, AddIntServer, RemIntServer, NodeType;
- FROM Dos IMPORT FileHandlePtr, Open, Close, Read, oldFile;
- FROM Intuition IMPORT NewScreen, ScreenPtr, OpenScreen, CloseScreen,
- ScreenToBack, ScreenFlags, ScreenFlagSet,
- customScreen, MoveScreen, WindowPtr, OpenWindow,
- CloseWindow, IDCMPFlags, IDCMPFlagSet, WindowFlags,
- WindowFlagSet;
- FROM Graphics IMPORT SetRGB4, RastPortPtr, BitMapPtr, ViewModes,
- ViewModeSet, BitMap, InitBitMap, AllocRaster,
- BltClear, FreeRaster, ViewPortPtr;
- FROM GfxMacros IMPORT OffDisplay, OnDisplay;
- FROM Hardware IMPORT vertb;
-
- FROM Arts IMPORT TermProcedure, Assert;
- FROM Strings IMPORT Compare, first, last;
-
- FROM LoadBody IMPORT LoadBody;
-
- (*---------------------------------------------------------------------------
- ! !
- ! Variables from Definition: !
- ! !
- -----------------------------------------------------------------------------
-
- (*--------------------------- Types: ------------------------------------*)
-
- TYPE
- IFFTitles = (BMHD,CMAP,GRAB,DEST,CAMG,CRNG,BODY,SPRT,CCRT,CMHD,DPPV);
- IFFTitleSet = SET OF IFFTitles;
- (* SPRT,CCRT,CMHD,DPPV not implemented !!! *)
-
- ViewTypes = (vt0,Ersy,Lace,LPen,vt4,vt5,vt6,vt7,Gaud,Color,DblPF,HoMod,
- vt12,vt13,vt14,Hires,v16);
- ViewTypeSet = SET OF ViewTypes;
- (* which ViewModes are selected *)
-
- TYPE
-
- (*------------- The Structure that keeps all the data: ------------------*)
- (* You don't have to understand all variables in this structure! Only some *)
- (* are important, like BMHD.width/height or CMAP.red[] etc. The other data *)
- (* is used by the Routines that are exported from this module,like DoCycle *)
- (* etc. *)
-
- IFFInfoTypePtr = POINTER TO IFFInfoType;
- IFFInfoType = RECORD
- (* This contains all Data needed for a Picture *)
-
- (*------ Which Data is availble: ------*)
- IFFTitle: IFFTitleSet; (* all Sub-Records, whose equally named Flag*)
- (* is set here, contain readable data *)
-
- (*------ Information on BitMap: ------*)
- BMHD: RECORD
-
- width,height: INTEGER; (* the Picture's Size *)
- depth: UByte; (* it's Depth (how many BitPlanes) *)
- left,top: INTEGER; (* it's Location *)
- masking: UByte; (* Masking (see Documentation) *)
- transCol: INTEGER; (* Transparent Color *)
- xAspect,yAspect: UByte; (* Verzerrung *)
- scrnWidth,scrnHeight: INTEGER; (* The Image's Screen's Size *)
- END;
-
- (*------ Information on Colors: ------*)
- CMAP: RECORD
-
- colorCnt: CARDINAL; (* Number of Colors used *)
- red,green,blue: ARRAY[0..63] OF UByte;
- (* the Colors (I hope for 6 Bitplanes to be possible anytime) *)
- END;
-
- (*------ Information on HotSpot: ------*)
- GRAB: RECORD
-
- hotX,hotY: INTEGER; (* Hot-Spot of this Image (if exists *)
- END;
-
- (*------ Information on Destination-Bitmap: ------*)
- DEST: RECORD
- depth: UByte; (* number of Planes *)
- planePick: CARDINAL;
- planeOnOff: CARDINAL; (* set or clear other Planes ? *)
- planeMask: CARDINAL; (* planes to be changed *)
- END;
-
- (*------ Information on any Special ViewMode: ------*)
- CAMG: RECORD
- viewType: ViewTypeSet; (* ViewMode *)
- END;
-
- (*------ Information on ColorCycling: ------*)
- CRNG: RECORD
- count: CARDINAL; (* Number of ColorCyclings *)
- data: ARRAY[0..15] OF RECORD
-
- rate: INTEGER; (* velocity, 800H is 60 per second *)
- on: BOOLEAN; (* decide, wether CRNG is active or not *)
- forward: BOOLEAN; (* Direction (DPaint) *)
- low,high: UByte; (* lower and upper Color of this Range *)
- END;
- END;
- (*------ Internal Information: ------*)
- Internal: RECORD
- CycleID: CARDINAL; (* that's to distinguish different cyclings *)
- END;
- END;
-
- (* That's been quite a complex Variable. If you wanna use it, do it this *)
- (* way: *)
- (* e.g. You wanna know, how Deep your Image is. Ça marche comme ça: *)
- (* MyDepth := IFFInfo.BMHD.depth; *)
- (* You can get the speed of the second Colorcycle this way: *)
- (* speed := IFFInfo.CRNG.data[2].rate; *)
-
- (*-------------- That's the Variable, that contains all Data ------------*)
- (* this should be imported to your Module to get the Data. Don't forget to *)
- (* save the data, e.g. to a variable of the same type. Everytime you load *)
- (* a new IFF-File, the data is scratched !!! (i.e. the new data is written *)
- (* into this structure.) *)
-
- VAR
- IFFInfo: IFFInfoType;
-
- (*-------------------- The NewScreen-Structure. -------------------------*)
- (* this can be used to open the Screen, if dontopen is specified *)
-
- VAR
- NuScreen: NewScreen;
-
- (*-------------------- The NewWindow-Structure. -------------------------*)
- (* this can be used to open the Window later. Don't forget to put Screen- *)
- (* Ptr in NuWindow.screen !!! *)
-
- VAR
- NuWindow: NewWindow;
-
- *)
-
- (*-------------------------------------------------------------------------*)
- (* *)
- (* Internal Variables and Types: *)
- (* *)
- (*-------------------------------------------------------------------------*)
-
- CONST
- MOVEMS = 48E7H; (* that's the 68000-Instruction MOVEM to save Registers*)
- MOVEML = 4CDFH; (* that's MOVEM to load Registers *)
-
- TYPE
- CyclingInfo = RECORD
- int: Interrupt; (* The Cycling's Interrupt *)
- VP: ViewPortPtr; (* The Cycling's ViewPort *)
- count: ARRAY[0..15] OF CARDINAL; (* counts Cycling-Positions *)
- speedCnt: ARRAY[0..15] OF CARDINAL; (* counts Speed *)
- (* The Cycling-Direction (TRUE=Forwards) *)
- END;
-
- VAR
- InH: FileHandlePtr;
- i,j,k: LONGINT;
- length: INTEGER;
- LineLength: LONGINT; (* Bytes per Image-Line *)
- LineWidth: LONGINT; (* Bytes per Screen-Line *)
- BM: BitMapPtr;
- Compression: BOOLEAN; (* Decide, wether data is compressed or not *)
- MaskPlane: BOOLEAN; (* Is there a Mask-Plane ?? *)
- Buffer: ADDRESS;
- TextBuffer: POINTER TO ARRAY[0..63] OF ARRAY[0..3] OF CHAR;
- LONGBuffer: POINTER TO ARRAY[0..63] OF LONGCARD;
- WORDBuffer: POINTER TO ARRAY[0..127] OF INTEGER;
- BYTEBuffer: POINTER TO ARRAY[0..255] OF UByte;
- len: LONGINT;
- BitMaps: ARRAY[0..5] OF ADDRESS;
- Byte,Byte2: UByte;
- Line,Plane: LONGINT;
- Location,Right: POINTER TO UByte;
- RQPos,RQLen: LONGCARD;
- RQBuffer: POINTER TO ARRAY[0..511] OF UByte;
- SpecialView: LONGSET;
- Exit: BOOLEAN;
- NoErr: BOOLEAN;
- CycleInfos: ARRAY[0..31] OF CyclingInfo;
- IntInfo: IFFInfoTypePtr;
- IntNum: CARDINAL;
- IntCount,IntCount2,IntCount3: CARDINAL;
-
- (*----------- Procedure called by machinecode to get Data: --------------*)
-
- PROCEDURE Read512();
-
- BEGIN
- len := Read(InH,RQBuffer,512);
- END Read512;
-
- (*-------------------------------------------------------------------------*)
- (* *)
- (* R e a d I L B M : *)
- (* *)
- (*-------------------------------------------------------------------------*)
-
- (*
- TYPE
- ReadILBMFlags = (front,visible,dontopen,window);
- ReadILBMFlagSet = SET OF ReadILBMFlags;
- *)
-
- PROCEDURE ReadILBM(name: ARRAY OF CHAR; Flags: ReadILBMFlagSet;
- VAR Screen: ScreenPtr; VAR Window: WindowPtr): BOOLEAN;
- (* ReadILBM() lädt ein IFF-Bild und öffnet das geladene Bild als Screen. *)
- (* Name: The IFF-Filename *)
- (* Flags: *)
- (* -front: decides whether Screen is first or last one while loading *)
- (* -visible: decides if display should be turned off (that's faster) *)
- (* -dontopen: avoids to open the Screen. The Returned value is NIL. The *)
- (* BitMap of the loaded Imagery can be found in NuScreen.customBitMap. *)
- (* Don't forget to free the image's Memory if it's no more needed and *)
- (* the Memory needed for the BitMap-Structure. *)
- (* -window: if set, an Window of the same size as the Image is opened. *)
- (* So, Gadgets etc. can be added to it. *)
- (* Screen: Pointer to Screen-structure of opened Screen *)
- (* Window: Pointer to the opened Window or NIL if window isn't set. *)
- (* Result: FALSE if error occured. Then there's no Screen opened. *)
-
- PROCEDURE OpenScrn();
- (* this initializes the Screen, Window and Bitmap, if they're needed. *)
- (* Screen and Window are opened. *)
-
- BEGIN
- WITH NuScreen DO
- width := IFFInfo.BMHD.scrnWidth;
- IF width<IFFInfo.BMHD.width THEN
- width := IFFInfo.BMHD.width;
- END;
- height := IFFInfo.BMHD.scrnHeight;
- IF height<IFFInfo.BMHD.height THEN
- height := IFFInfo.BMHD.height;
- END;
- leftEdge := IFFInfo.BMHD.left;
- topEdge := IFFInfo.BMHD.top;
- depth := IFFInfo.BMHD.depth;
- viewModes := ViewModeSet{};
- IF (width>400) AND (depth<5) THEN INCL(viewModes,hires) END;
- IF height>300 THEN INCL(viewModes,lace) END;
- IF Lace IN IFFInfo.CAMG.viewType THEN INCL(viewModes,lace ) END;
- IF HoMod IN IFFInfo.CAMG.viewType THEN INCL(viewModes,ham ) END;
- IF Hires IN IFFInfo.CAMG.viewType THEN INCL(viewModes,hires ) END;
- IF DblPF IN IFFInfo.CAMG.viewType THEN INCL(viewModes,dualpf) END;
- IF (ViewTypeSet{} = (ViewTypeSet{DblPF,HoMod} * IFFInfo.CAMG.viewType))
- AND (depth=6) THEN
- INCL(viewModes,extraHalfbrite);
- END;
- detailPen := 0; blockPen := 0;
- type := customScreen+ScreenFlagSet{screenQuiet};
- font := NIL;
- defaultTitle := NIL;
- gadgets := NIL;
- customBitMap := NIL;
- IF NOT(front IN Flags) THEN topEdge := 600 END;
- END;
- IF dontopen IN Flags THEN
- INCL(NuScreen.type,customBitMap);
- WITH NuScreen DO
- customBitMap := AllocMem(SIZE(BitMap),MemReqSet{public});
- InitBitMap(customBitMap^,depth,width,height);
- i:=0;
- REPEAT
- customBitMap^.planes[i] := AllocRaster(width,height);
- BitMaps[i] := customBitMap^.planes[i];
- IF BitMaps[i]=NIL THEN
- NoErr:=FALSE
- ELSE
- BltClear(BitMaps[i],width DIV 8 * height,0);
- END;
- INC(i);
- UNTIL (i=depth) OR NOT(NoErr);
- IF NOT(NoErr) THEN (* error: give allocated Mem back: *)
- WHILE i>1 DO
- DEC(i);
- FreeRaster(BitMaps[i],width,height);
- END;
- END;
- END;
- ELSE
- Screen := OpenScreen(NuScreen);
- IF Screen=NIL THEN
- NoErr := FALSE;
- ELSE
- IF NOT(front IN Flags) THEN
- ScreenToBack(Screen);
- MoveScreen(Screen,0,-600);
- END;
- BM := Screen^.rastPort.bitMap;
- FOR i:=0 TO NuScreen.depth-1 DO
- BitMaps[i] := BM^.planes[i];
- END;
- WITH IFFInfo.CMAP DO
- FOR i:=0 TO colorCnt-1 DO
- SetRGB4(ADR(Screen^.viewPort),i,red[i],green[i],blue[i]);
- END;
- END;
- END;
- END;
- WITH NuWindow DO
- leftEdge := 0;
- topEdge := 0;
- width := IFFInfo.BMHD.width;
- height := IFFInfo.BMHD.height;
- detailPen := 1;
- blockPen := 0;
- idcmpFlags := IDCMPFlagSet{};
- flags := WindowFlagSet{borderless,noCareRefresh};
- firstGadget := NIL;
- checkMark := NIL;
- title := NIL;
- screen := Screen;
- bitMap := NIL;
- type := customScreen;
- END;
- IF (window IN Flags) AND (Screen#NIL) THEN
- Window := OpenWindow(NuWindow);
- IF Window=NIL THEN
- CloseScreen(Screen);
- Screen := NIL;
- NoErr := FALSE;
- END;
- END;
- IF NOT(visible IN Flags) THEN OffDisplay() END;
- END OpenScrn;
-
- PROCEDURE ReadQuick(To: ADDRESS; Count: CARDINAL);
-
- VAR
- ToPtr: POINTER TO ARRAY[0..9999] OF UByte;
- i: CARDINAL;
-
- BEGIN
- ToPtr := To;
- i := 0;
- REPEAT
- IF RQPos=RQLen THEN
- RQLen := Read(InH,RQBuffer,512);
- RQPos := 0;
- END;
- ToPtr^[i] := ORD(RQBuffer^[RQPos]);
- INC(RQPos); INC(i);
- UNTIL i=Count;
- END ReadQuick;
-
- BEGIN
- IFFInfo.IFFTitle := IFFTitleSet{};
-
- IF NOT(visible IN Flags) THEN OffDisplay() END;
- NoErr := TRUE; Screen := NIL; Window := NIL;
- RQPos := 0; RQLen := 0;
-
- InH := Open(ADR(name),oldFile);
- IF InH=NIL THEN NoErr := FALSE END;
-
- IF NoErr THEN
-
- (*------ File Header: ------*)
-
- len := Read(InH,Buffer,12);
- IF (len=NIL) OR (Compare(TextBuffer^[0],first,4,"FORM",TRUE)#0) OR
- (Compare(TextBuffer^[2],first,4,"ILBM",TRUE)#0) THEN NoErr := FALSE END;
-
- Exit := FALSE;
-
- (*------ Main Loop: ------*)
-
- WHILE NoErr AND NOT(Exit) DO
- len := Read(InH,Buffer,4);
-
- (*------ BMHD: ------*)
-
- IF Compare(TextBuffer^[0],first,4,"BMHD",TRUE)=0 THEN
- INCL(IFFInfo.IFFTitle,BMHD);
- len := Read(InH,Buffer,4);
- len := Read(InH,Buffer,LONGBuffer^[0]);
- WITH IFFInfo.BMHD DO
- width := WORDBuffer^[0];
- height := WORDBuffer^[1];
- left := WORDBuffer^[2];
- top := WORDBuffer^[3];
- depth := BYTEBuffer^[8];
- masking := BYTEBuffer^[9];
- MaskPlane := masking=1;
- Compression := BYTEBuffer^[10]=1;
- transCol := WORDBuffer^[6];
- xAspect := BYTEBuffer^[14];
- yAspect := BYTEBuffer^[15];
- scrnWidth := WORDBuffer^[8];
- scrnHeight:= WORDBuffer^[9];
- END;
-
- (*------ CMAP: ------*)
-
- ELSIF Compare(TextBuffer^[0],first,4,"CMAP",TRUE)=0 THEN
- INCL(IFFInfo.IFFTitle,CMAP);
- len := Read(InH,Buffer,4);
- i := LONGBuffer^[0];
- len := Read(InH,Buffer,i);
- WITH IFFInfo.CMAP DO
- colorCnt := i DIV 3;
- j := 0;
- FOR k:=0 TO colorCnt DO
- red [k] := SHIFT(BYTEBuffer^[j ],-4);
- green[k] := SHIFT(BYTEBuffer^[j+1],-4);
- blue [k] := SHIFT(BYTEBuffer^[j+2],-4);
- INC(j,3);
- END;
- INC(colorCnt);
- END;
-
- (*------ CAMG: ------*)
-
- ELSIF Compare(TextBuffer^[0],first,4,"CAMG",TRUE)=0 THEN
- INCL(IFFInfo.IFFTitle,CAMG);
- len := Read(InH,Buffer,8);
- IFFInfo.CAMG.viewType := CAST(ViewTypeSet,LONGBuffer^[1]);
-
- (*------ GRAB: ------*)
-
- ELSIF Compare(TextBuffer^[0],first,4,"GRAB",TRUE)=0 THEN
- INCL(IFFInfo.IFFTitle,GRAB);
- len := Read(InH,Buffer,8);
- IFFInfo.GRAB.hotX := WORDBuffer^[2];
- IFFInfo.GRAB.hotY := WORDBuffer^[3];
-
- (*------ DEST: ------*)
-
- ELSIF Compare(TextBuffer^[0],first,4,"DEST",TRUE)=0 THEN
- INCL(IFFInfo.IFFTitle,DEST);
- len := Read(InH,Buffer,12);
- WITH IFFInfo.DEST DO
- depth := BYTEBuffer^[4];
- planePick := WORDBuffer^[3];
- planeOnOff := WORDBuffer^[4];
- planeMask := WORDBuffer^[5];
- END;
-
- (*------ CRNG: ------*)
-
- ELSIF Compare(TextBuffer^[0],first,4,"CRNG",TRUE)=0 THEN
- IF NOT(CRNG IN IFFInfo.IFFTitle) THEN
- IFFInfo.CRNG.count := 0;
- END;
- INCL(IFFInfo.IFFTitle,CRNG);
- len := Read(InH,Buffer,12);
- WITH IFFInfo.CRNG.data[IFFInfo.CRNG.count] DO
- rate := WORDBuffer^[3];
- on := 0 IN CAST(BITSET,WORDBuffer^[4]);
- forward := NOT(1 IN CAST(BITSET,WORDBuffer^[4]));
- low := BYTEBuffer^[10];
- high := BYTEBuffer^[11];
- (* this line is only to identify illegal data, that some IFF-Files contain:*)
- on := on AND (low<IFFInfo.CMAP.colorCnt)
- AND (high<IFFInfo.CMAP.colorCnt);
- END;
- INC(IFFInfo.CRNG.count);
-
- (*------ BODY: ------*)
-
- ELSIF Compare(TextBuffer^[0],first,4,"BODY",TRUE)=0 THEN
- OpenScrn();
- IF NoErr THEN
- len := Read(InH,Buffer,4);
- LineLength := SHIFT(SHIFT(CAST(INTEGER,CAST(BITSET,
- IFFInfo.BMHD.width+15) * {4..15}),-4),1);
- LineWidth := SHIFT(NuScreen.width,-3);
- IF Compression THEN
- (*------ let's load the BitMap's Data: ------*)
- LoadBody(Read512, RQBuffer, ADR(BitMaps[0]), LineLength,
- LineWidth, IFFInfo.BMHD.height, NuScreen.depth,
- MaskPlane); (* this does all the work very quickly *)
- ELSE (* not compressed *)
- (*------ to load uncompressed Images is less time-critical: *)
- FOR Line := 0 TO IFFInfo.BMHD.height-1 DO
- FOR Plane := 0 TO NuScreen.depth-1 DO
- ReadQuick(BitMaps[Plane]+ LineWidth*Line,LineLength);
- END;
- IF MaskPlane THEN
- ReadQuick(Buffer,LineLength);
- END;
- END;
- END;
- END; (* IF NoErr *)
- Exit := TRUE;
-
- (*------ Ignore unknown data: ------*)
-
- ELSE
- len := Read(InH,Buffer,4);
- i := LONGBuffer^[0];
- WHILE i>256 DO
- len := Read(InH,Buffer,256);
- DEC(i,256);
- END;
- len := Read(InH,Buffer,i);
- END;
-
- END; (* WHILE NOT(Exit DO *)
- END; (* IF NoErr *)
-
- IF InH#NIL THEN Close(InH); InH := NIL; END;
- IF NOT(NoErr) THEN
- IF Window#NIL THEN CloseWindow(Window) END;
- IF Screen#NIL THEN CloseScreen(Screen) END;
- END;
- OnDisplay();
- RETURN NoErr;
- END ReadILBM; (* that's it *)
-
- (*--------------- Procedures for ColorCycling: --------------------------*)
-
- PROCEDURE CycleInterrupt();
-
- BEGIN
- INLINE(MOVEMS,3F3EH);
-
- IntInfo := ADDRESS(REG(9));
- IF CRNG IN IntInfo^.IFFTitle THEN
- IntNum := IntInfo^.Internal.CycleID;
- WITH CycleInfos[IntNum] DO
- IntCount := 0;
- WHILE IntCount<IntInfo^.CRNG.count DO
- WITH IntInfo^.CRNG.data[IntCount] DO
- IF on THEN
- INC(speedCnt[IntCount],rate);
- IF speedCnt[IntCount]>=4000H THEN
- (* this 4000H should have been 8000H, but then it's to slow. *)
- (* dont know why, but this way, it works correctly *)
- DEC(speedCnt[IntCount],4000H);
- IF forward THEN
- IF count[IntCount]<=low THEN
- count[IntCount]:=high;
- ELSE
- DEC(count[IntCount]);
- END;
- ELSE
- IF count[IntCount]>=high THEN
- count[IntCount]:=low;
- ELSE
- INC(count[IntCount]);
- END;
- END;
- IntCount3 := count[IntCount];
- IntCount2 := low;
- WHILE IntCount2<=high DO
- SetRGB4(VP,IntCount2,IntInfo^.CMAP.red[IntCount3],
- IntInfo^.CMAP.green[IntCount3],
- IntInfo^.CMAP.blue[IntCount3]);
- INC(IntCount3);
- IF IntCount3>high THEN IntCount3:=low END;
- INC(IntCount2);
- END;
- END;
- END;
- END;
- INC(IntCount);
- END;
- END;
- END;
-
- INLINE(MOVEML,7CFCH);
- END CycleInterrupt;
-
- PROCEDURE DoCycle(Info: IFFInfoTypePtr; Screen: ScreenPtr): BOOLEAN;
- (* this creates an interrupt, that does cycling. You needn't worry, *)
- (* whether there's cycling data or not. Don't forget to call EndCycle to *)
- (* remove the Cycling-Interrupt !!! *)
- (* If result is false, any error occured. Don't call EndCycle in this case!*)
-
- BEGIN
- i:=0;
- LOOP
- IF CycleInfos[i].VP=NIL THEN EXIT END;
- INC(i);
- IF i=32 THEN RETURN FALSE END;
- END;
- Info^.Internal.CycleID := i;
- WITH CycleInfos[i] DO
- VP := ADR(Screen^.viewPort);
- IF CRNG IN Info^.IFFTitle THEN
- FOR j:=0 TO Info^.CRNG.count-1 DO
- count[j] := Info^.CRNG.data[j].low;
- speedCnt[j] := 0;
- END;
- END;
- WITH int DO
- node.type := interrupt;
- node.pri := -60;
- node.name := NIL;
- data := Info;
- code := ADR(CycleInterrupt);
- END;
- AddIntServer(vertb,ADR(int));
- END;
- RETURN TRUE;
- END DoCycle;
-
- PROCEDURE EndCycle(Info: IFFInfoTypePtr);
- (* remove cycling-Interrupt *)
-
- BEGIN
- i := Info^.Internal.CycleID;
- RemIntServer(vertb,ADR(CycleInfos[i].int));
- CycleInfos[i].VP := NIL;
- END EndCycle;
-
- (*------------------------ TermProcedure: -------------------------------*)
-
- PROCEDURE CleanUp();
-
- BEGIN
- IF InH#NIL THEN Close(InH) END;
- FreeMem(Buffer,768);
- END CleanUp;
-
- (*----------------------- Initialization: -------------------------------*)
-
- BEGIN
- Buffer := AllocMem(768,MemReqSet{chip,memClear});
- Assert(Buffer#NIL,ADR("Not enough ChipMem !!!"));
- TextBuffer := Buffer;
- LONGBuffer := Buffer;
- WORDBuffer := Buffer;
- BYTEBuffer := Buffer;
- RQBuffer := ADDRESS(Buffer+256);
- InH := NIL;
- FOR i:=0 TO 31 DO CycleInfos[i].VP:=NIL END;
- TermProcedure(CleanUp);
- END IFFLoad.
-